home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
attall
/
atomic.frm
< prev
next >
Wrap
Text File
|
1995-05-07
|
12KB
|
425 lines
VERSION 2.00
Begin Form Atomic
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Call the Atomic Clock"
ClientHeight = 3915
ClientLeft = 2460
ClientTop = 930
ClientWidth = 4725
Height = 4320
Left = 2400
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3915
ScaleWidth = 4725
Top = 585
Width = 4845
Begin MSComm Comm1
Interval = 1000
Left = 3390
Top = 1125
End
Begin SSCheck DST
Caption = "Use Daylight Savings Time"
Font3D = 0 'None
Height = 285
Left = 225
TabIndex = 4
Top = 960
Width = 2640
End
Begin ComboBox TimeZone
BackColor = &H00FFFFFF&
Height = 300
Left = 375
Style = 2 'Dropdown List
TabIndex = 3
Top = 450
Width = 4065
End
Begin CommandButton Command1
Cancel = -1 'True
Caption = "Cancel"
Height = 345
Index = 2
Left = 2370
TabIndex = 1
Top = 3300
Width = 2085
End
Begin CommandButton Command1
Caption = "Dial"
Default = -1 'True
Height = 345
Index = 1
Left = 2370
TabIndex = 0
Top = 2790
Width = 2070
End
Begin CommandButton Command1
Caption = "Reset Defaults"
Height = 345
Index = 0
Left = 2370
TabIndex = 12
Top = 2280
Width = 2070
End
Begin SSFrame Frame3D1
Caption = "COM Port"
Font3D = 0 'None
ForeColor = &H00000000&
Height = 1530
Left = 255
TabIndex = 7
Top = 2190
Width = 1965
Begin SSOption ComPort
Caption = "COM&4:"
Font3D = 0 'None
ForeColor = &H00000000&
Height = 240
Index = 3
Left = 135
TabIndex = 11
Top = 1185
Width = 780
End
Begin SSOption ComPort
Caption = "COM&3:"
Font3D = 0 'None
ForeColor = &H00000000&
Height = 240
Index = 2
Left = 135
TabIndex = 10
Top = 885
Width = 780
End
Begin SSOption ComPort
Caption = "COM&2:"
Font3D = 0 'None
ForeColor = &H00000000&
Height = 240
Index = 1
Left = 135
TabIndex = 9
Top = 585
Width = 780
End
Begin SSOption ComPort
Caption = "COM&1:"
Font3D = 0 'None
ForeColor = &H00000000&
Height = 240
Index = 0
Left = 135
TabIndex = 8
Top = 285
Width = 780
End
End
Begin TextBox DialString
Height = 300
Left = 375
TabIndex = 6
Text = "ATDT 1 303 494-4774"
Top = 1710
Width = 4080
End
Begin Label Status
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Height = 240
Left = 1125
TabIndex = 13
Top = 15
Width = 3300
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "Modem Dial String"
Height = 210
Index = 1
Left = 225
TabIndex = 5
Top = 1440
Width = 2145
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "Time Zone"
Height = 240
Index = 0
Left = 195
TabIndex = 2
Top = 165
Width = 1320
End
End
Option Explicit
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
Dim ControlsDisabled As Integer
Dim InString As String
Dim TString As String
Dim Aborted As Integer
Sub Command1_Click (Index As Integer)
Dim StartTime As Double
Dim I As Integer
Dim NewD As Double
Dim OldD As Double
Dim DSTFlag As String
Dim OffBy As String
If Index = 0 Then 'Reset Defaults
ResetDefaults
Status.Caption = ""
End If
If Index = 1 Then 'Dial
SaveModemSettings
Aborted = False
Status.Caption = ""
Command1(0).Enabled = False
Command1(1).Enabled = False
TimeZone.Enabled = False
DST.Enabled = False
DialString.Enabled = False
Frame3D1.Enabled = False
ControlsDisabled = True
On Local Error GoTo ErrHndl
For I% = 0 To 3
If ComPort(I%).Value Then comm1.CommPort = I% + 1
Next I%
If Aborted Then Exit Sub
comm1.Settings = "1200,N,8,1"
If Aborted Then Exit Sub
comm1.PortOpen = True
If Aborted Then Exit Sub
comm1.Output = DialString.Text + Chr$(13) + Chr(10)
StartTime = Timer
LastTime = 0
Do
DoEvents
If LastTime <> Int(Timer) Then
If Not Aborted Then Status.Caption = "Connecting - " + Format$(45 - Int(Timer - StartTime)) + " seconds until timeout."
LastTime = Int(Timer)
End If
Loop Until comm1.InBufferCount >= 600 Or ((Timer - StartTime) > 45) Or Aborted
If Aborted Then Exit Sub
If (Timer - StartTime) > 45 Then
Status.Caption = "Timed out."
Exit Sub
End If
Status.Caption = "Setting time."
InString$ = comm1.Input
If Aborted Then Exit Sub
InString$ = Mid$(InString$, InStr(InString$, "*") + 1, 80)
NewD = DateValue(Mid$(InString$, 12, 2) + "/" + Mid$(InString$, 15, 2) + "/" + Mid$(InString$, 9, 2))
NewD = NewD + TimeValue(Mid$(InString$, 18, 8))
NewD = NewD - (TimeZone.ListIndex - 11) * (1 / 24)
DSTFlag$ = Mid$(InString$, 27, 2)
If ((DSTFlag >= "01") And (DSTFlag <= "50")) Then
NewD = NewD - (1 / 24)
End If
If DST.Value Then
NewD = NewD + (1 / 24)
End If
OldD = Date + Time
If Year(NewD) >= 1993 Then
Date = Format$(NewD, "mm/dd/yy")
Time = Format$(NewD, "hh:mm:ss")
If OldD > NewD Then
OffBy = "fast"
Else
OffBy = "slow"
End If
MsgBox "Time set to " + Format$(NewD, "hh:mm:ss") + ". Clock was " + OffBy$ + " by " + Format$(Abs(NewD - OldD), "hh:mm:ss") + "."
AtomicTimeWasSet = True
Status.Caption = "Time set."
Else
MsgBox "Error getting date and time."
End If
If Aborted Then Exit Sub
HangUp
If Aborted Then Exit Sub
On Local Error Resume Next
Unload Atomic
End If
If Index = 2 Then 'Cancel
If ControlsDisabled Then
HangUp
EnableControls
Aborted = True
Status.Caption = "Aborted."
Else
Unload Atomic
End If
End If
EnableControls
Exit Sub
ErrHndl:
MsgBox "Error: " + Error(Err)
EnableC